home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / DMTDEMOS / GETNEXT.DEM < prev    next >
Text File  |  1994-07-02  |  3KB  |  131 lines
  1. program GetNextSample;
  2.  
  3.  uses crt, DMT;
  4.  
  5.  var
  6.    FileInfoBuffer : FileInfoStruct;  { The FileInfoStruct data type is defined in the DMT unit }
  7.  
  8.    FileSpec       : string;
  9.  
  10.    Fname          : string[ 12 ];
  11.  
  12.    Attributes,
  13.    Count          : byte;
  14.  
  15.    Hr,
  16.    Min,
  17.    Sec,
  18.    Month,
  19.    Day,
  20.    Year           : word;
  21.  
  22.    MatchFlag      : boolean;
  23.  
  24. procedure DecodeDate( Date    : word;
  25.  
  26.                       var
  27.                         Month,
  28.                         Day,
  29.                         Year  : word );
  30.  
  31. begin
  32.   Month := ( Date and $1E0 ) shr 5;
  33.   Day   := Date and $1F;
  34.   Year  := ( Date shr 9 ) + 1980;
  35. end;
  36.  
  37. procedure DecodeTime( Time   : word;
  38.  
  39.                       var
  40.                         Hr,
  41.                         Min,
  42.                         Sec  : word );
  43.  
  44. begin
  45.   Hr  := Time shr 11;
  46.   Min := ( Time and $7E0 ) shr 5;
  47.   Sec := ( Time and $1f ) * 2;
  48. end;
  49.  
  50. procedure DisplayFileInfo;
  51.  
  52. begin
  53.  Count := 1;
  54.  Fname := '';
  55.  
  56.  with FileInfoBuffer do
  57.    begin
  58.  
  59.      while ( FileNameExt[ Count ] <> #0 ) do
  60.        begin
  61.          Fname := Fname + FileNameExt[ Count ];
  62.          inc( Count );
  63.        end;
  64.  
  65.      write( Fname :12 );
  66.      write( InsComma( FileSize ):12 );
  67.  
  68.      DecodeTime( FileTime, Hr, Min, Sec );
  69.  
  70.      write( '   ', Hr:2, ':', Min:2, ':', Sec:2 );
  71.  
  72.      DecodeDate( FileDate, Month, Day, Year );
  73.  
  74.      writeln( '   ', Month:2, '/', Day:2, '/', Year:2 );
  75.    end;
  76. end;
  77.  
  78. begin
  79.   Color( 7, 0 );
  80.   clrscr;
  81.  
  82.   SetDTA( seg( FileInfoBuffer ), ofs( FileInfoBuffer ) );  { Call SetDTA procedure }
  83.  
  84.   writeln;
  85.   write('Enter file(s) to be searched : ');
  86.   readln( FileSpec );
  87.  
  88.   if ( FileSpec = '' ) then
  89.     FileSpec := '*.*';
  90.  
  91.   Attributes := 255;   { Sets all available attributes }
  92.  
  93.   GetFirst( FileSpec, Attributes );   { Call GetFirst procedure }
  94.  
  95.   if ( ErrFlag ) then
  96.     begin
  97.       writeln( #7 );
  98.       writeln( ShowError( GetErrCode ) );
  99.     end
  100.   else
  101.     begin
  102.       clrscr;
  103.       writeln( ' File Name        Size      Time       Date' );
  104.       window( 1, 3, 80, 25 );
  105.  
  106.       DisplayFileInfo;
  107.  
  108.       repeat
  109.         GetNext;   { Call GetNext procedure }
  110.  
  111.         if ( ErrFlag ) then
  112.           begin
  113.             writeln;
  114.             writeln( 'End of the directory listing...' );
  115.           end
  116.         else
  117.           begin
  118.             DisplayFileInfo;
  119.             if ( wherey = 21 ) then
  120.               begin
  121.                 writeln( #13#10, ' --- More ---' );
  122.                 readln;
  123.                 clrscr;
  124.               end;
  125.           end
  126.       until ( ErrFlag = true );
  127.     end;
  128.   GetEnter;
  129. end.
  130.  
  131.